home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MEMORY.SWG / 0050_TStream for XMS.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  8KB  |  339 lines
  1.  
  2. {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V-,X+,Y+}
  3. {.$DEFINE OPRO}
  4. {
  5.   This unit adds an XMS-memory stream to TStream or IdStream
  6.   depending on the define above.
  7.   (c) 1994 Helge Olav Helgesen
  8.   If you have any comments, please leave them in the Pascal
  9.   conference on Rime or U'NI, or on InterNet to me at
  10.   helge.helgesen@midnight.powertech.no
  11. }
  12. {$IFNDEF MSDOS}
  13.   !! This unit must be compiled under real mode !!
  14. {$ENDIF}
  15. Unit Xms;
  16.  
  17. interface
  18.  
  19. uses
  20. {$IFDEF OPRO}
  21.   OpRoot,
  22. {$ELSE}
  23.   Objects,
  24. {$ENDIF}
  25.   OpDos, OpXms;
  26.  
  27. type
  28.   PXmsStream = ^TXmsStream; { pointer to TXmsStream }
  29.   TXmsStream = object({$IFDEF OPRO}IdStream{$ELSE}TStream{$ENDIF})
  30.     XmsSizeInK, { allocated size in kilobytes }
  31.     XmsHandle: word; { XMS Handle }
  32.     TotalSize, { total size in bytes }
  33.     CurOfs, { current offset into the stream }
  34.     UsedSize: longint; { size of used stream }
  35.  
  36.     constructor Init(MemNeeded: word); { allocate ext. memory and init vars }
  37.     destructor  Done; virtual; { deallocate ext. memory }
  38.  
  39.     procedure   Seek(WhereTo: longint); virtual; { seek within stream }
  40.     function    GetPos: longint; virtual; { get curret offset }
  41.     function    GetSize: longint; virtual; { get used size of stream }
  42.     procedure   SetPos(Ofs: longint; Mode: byte); virtual; { seek using POS mode
  43.  }
  44.  
  45.     procedure   Truncate; virtual; { truncate stream to current size }
  46.  
  47.     procedure   Write(var Buf; Count: Word); virtual; { writes Buf to the stream
  48.  }
  49.     procedure   Read(var Buf; Count: Word); virtual; { reads Buf from the stream
  50.  }
  51.   end; { TXmsStream }
  52.  
  53. {$IFNDEF OPRO}
  54. var
  55.   InitStatus: byte; { detailed error code from last Init or Done }
  56. {$ENDIF}
  57.  
  58. const
  59.   RealMemHandle = 0; { handle for Real Memory }
  60. {$IFNDEF OPRO}
  61.   PosAbs     = 0;               {Relative to beginning}
  62.   PosCur     = 1;               {Relative to current position}
  63.   PosEnd     = 2;               {Relative to end}
  64. {$ENDIF}
  65.  
  66. {$IFDEF OPRO}
  67. procedure SaveStream(const FileName: string; var S: IdStream);
  68.   { Saves a stream to disk, old file is erased! }
  69. procedure LoadStream(const FileName: string; var S: IdStream);
  70.   { Loads a stream from disk }
  71. {$ELSE}
  72. procedure SaveStream(const FileName: string; var S: TStream);
  73.   { Saves a stream to disk, old file is erased! }
  74. procedure LoadStream(const FileName: string; var S: TStream);
  75.   { Loads a stream from disk }
  76. {$ENDIF}
  77.  
  78. implementation
  79.  
  80. constructor TXmsStream.Init;
  81.   { You should already have tested if XMS is installed! }
  82. begin
  83.   if not inherited Init then Fail;
  84.   InitStatus:=AllocateExtMem(MemNeeded, XmsHandle);
  85.   if InitStatus>0 then Fail;
  86.   XmsSizeInK:=MemNeeded;
  87.   TotalSize:=LongInt(MemNeeded)*LongInt(1024);
  88.   UsedSize:=0;
  89.   CurOfs:=0;
  90. end; { TXmsStream }
  91.  
  92. destructor TXmsStream.Done;
  93. begin
  94.   FreeExtMem(XmsHandle);
  95.   inherited Done;
  96. end; { TXmsStream.Done }
  97.  
  98. procedure TXmsStream.Seek;
  99. begin
  100. {$IFDEF OPRO}
  101.   if idStatus=0 then
  102. {$ELSE}
  103.   if Status=stOk then
  104. {$ENDIF}
  105.   CurOfs:=WhereTo;
  106. end; { TXmsStream }
  107.  
  108. function TXmsStream.GetPos;
  109. begin
  110. {$IFDEF OPRO}
  111.   if idStatus=0 then
  112. {$ELSE}
  113.   if Status=stOk then
  114. {$ENDIF}
  115.   GetPos:=CurOfs else GetPos:=-1;
  116. end; { TXmsStream.GetPos }
  117.  
  118. function TXmsStream.GetSize;
  119. begin
  120. {$IFDEF OPRO}
  121.   if idStatus=0 then
  122. {$ELSE}
  123.   if Status=stOk then
  124. {$ENDIF}
  125.   GetSize:=UsedSize else GetSize:=-1;
  126. end; { TXmsStream.GetSize }
  127.  
  128. procedure TXmsStream.Truncate;
  129. begin
  130. {$IFDEF OPRO}
  131.   if idStatus=0 then
  132. {$ELSE}
  133.   if Status=stOk then
  134. {$ENDIF}
  135.   UsedSize:=CurOfs;
  136. end; { TXmsStream.Truncate }
  137.  
  138. procedure TXmsStream.Write;
  139. var
  140.   NumberisOdd: boolean;
  141.   x: word;
  142.   Source, Dest: ExtMemPtr;
  143. begin
  144. {$IFDEF OPRO}
  145.   if idStatus<>0 then
  146. {$ELSE}
  147.   if Status<>stOk then
  148. {$ENDIF}
  149.   Exit;
  150.   if LongInt(Count)+LongInt(CurOfs)>LongInt(TotalSize) then
  151.   begin
  152. {$IFDEF OPRO}
  153.     Error(101); { disk write error }
  154. {$ELSE}
  155.     Error(stWriteError, 0);
  156. {$ENDIF}
  157.     Exit;
  158.   end; { if }
  159.   NumberIsOdd:=Odd(Count);
  160.   if NumberIsOdd then Dec(Count);
  161.   Source.RealPtr:=@Buf;
  162.   Dest.ProtectedPtr:=CurOfs;
  163.   if Count>0 then
  164.   x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }
  165.                      XmsHandle, Dest) { dest data }
  166.   else x:=0;
  167.   if x>0 then { new error }
  168.   begin
  169. {$IFDEF OPRO}
  170.     Error(101); { disk write error }
  171. {$ELSE}
  172.     Error(stWriteError, x);
  173. {$ENDIF}
  174.     Exit;
  175.   end; { if }
  176.   Inc(CurOfs, Count); { adjust current offset }
  177.   if CurOfs>UsedSize then UsedSize:=CurOfs;
  178.   if not NumberisOdd then Exit;
  179.   asm { get last byte to transfer }
  180.     les  di, Buf
  181.     mov  bx, Count
  182.     mov  ax, es:[di+bx]
  183.     inc  Count
  184.     mov  x, ax
  185.   end; { asm }
  186.   Source.RealPtr:=@x;
  187.   Inc(Dest.ProtectedPtr, Count-1);
  188.   Count:=2;
  189.   x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }
  190.                      XmsHandle, Dest); { dest data }
  191.   if x>0 then { new error }
  192.   begin
  193. {$IFDEF OPRO}
  194.     Error(101); { disk write error }
  195. {$ELSE}
  196.     Error(stWriteError, x);
  197. {$ENDIF}
  198.     Exit;
  199.   end; { if }
  200.   Inc(CurOfs);
  201.   if CurOfs>UsedSize then UsedSize:=CurOfs;
  202. end; { TXmsStream.Write }
  203.  
  204. procedure TXmsStream.Read;
  205. var
  206.   NumberisOdd: boolean;
  207.   x: word;
  208.   Source, Dest: ExtMemPtr;
  209. begin
  210. {$IFDEF OPRO}
  211.   if idStatus<>0 then
  212. {$ELSE}
  213.   if Status<>stOk then
  214. {$ENDIF}
  215.   Exit;
  216.   if LongInt(CurOfs)+LongInt(Count)>LongInt(UsedSize) then
  217.   begin { read error }
  218. {$IFDEF OPRO}
  219.     Error(100); { read error }
  220. {$ELSE}
  221.     Error(stReadError, 0);
  222. {$ENDIF}
  223.     Exit;
  224.   end; { if }
  225.   NumberisOdd:=Odd(Count);
  226.   if NumberisOdd then Inc(Count);
  227.   Source.ProtectedPtr:=CurOfs;
  228.   Dest.RealPtr:=@Buf;
  229.   x:=MoveExtMemBlock(Count, XmsHandle, Source, { source data }
  230.                      RealMemHandle, Dest); { dest data }
  231.   if x>0 then
  232.   begin
  233. {$IFDEF OPRO}
  234.     Error(100); { read error }
  235. {$ELSE}
  236.     Error(stReadError, x);
  237. {$ENDIF}
  238.     Exit;
  239.   end; { if }
  240.   if NumberisOdd then Dec(Count);
  241.   Inc(CurOfs, Count);
  242. end; { TXmsStream.Read }
  243.  
  244. procedure TXmsStream.SetPos;
  245. begin
  246.   case Mode of
  247.     PosAbs: Seek(Ofs);
  248.     PosCur: Seek(LongInt(Ofs)+LongInt(CurOfs));
  249.     PosEnd: Seek(LongInt(UsedSize)-LongInt(Ofs));
  250.   end; { case }
  251. end; { TXmsStream.SetPos }
  252.  
  253. procedure SaveStream;
  254. {
  255.   Saves the stream to disk. No errorchecking is done
  256. }
  257. var
  258.   Buf: pointer;
  259.   x, BufSize: word;
  260.   f: file;
  261.   OldPos, l: longint;
  262. begin
  263.   Assign(f, FileName);
  264.   Rewrite(f, 1);
  265.   if S.GetSize=0 then
  266.   begin
  267.     Close(f);
  268.     Exit;
  269.   end; { if }
  270.   if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;
  271.   GetMem(Buf, BufSize);
  272.   OldPos:=S.GetPos;
  273.   l:=S.GetSize;
  274.   S.Seek(0);
  275.   while l<>0 do
  276.   begin
  277.     if l>BufSize then x:=BufSize else x:=l;
  278.     S.Read(Buf^, x);
  279. {$IFDEF OPRO}
  280.     if S.PeekStatus<>0 then
  281. {$ELSE}
  282.     if S.Status<>0 then
  283. {$ENDIF}
  284.     begin
  285.       Close(f);
  286.       Exit;
  287.     end; { if }
  288.     BlockWrite(f, Buf^, x);
  289.     Dec(l, x);
  290.   end; { while }
  291.   Close(f);
  292.   FreeMem(Buf, BufSize);
  293.   S.Seek(OldPos);
  294. end; { SaveStream }
  295.  
  296. procedure LoadStream;
  297. {
  298.   Loads the stream from disk. No errorchecking is done, you must allocate
  299.   enough memory yourself! Any old contents of the stream is erased.
  300. }
  301. var
  302.   f: file;
  303.   BufSize, x: word;
  304.   l: longint;
  305.   Buf: pointer;
  306. begin
  307.   if not ExistFile(FileName) then Exit;
  308.   Assign(f, FileName);
  309.   Reset(f, 1);
  310.   S.Seek(0);
  311.   S.Truncate;
  312.   l:=FileSize(f);
  313.   if l>0 then
  314.   begin
  315.     if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;
  316.     GetMem(Buf, BufSize);
  317.     while l<>0 do
  318.     begin
  319.       BlockRead(f, Buf^, BufSize, x);
  320.       S.Write(Buf^, x);
  321. {$IFDEF OPRO}
  322.       if S.PeekStatus<>0 then
  323. {$ELSE}
  324.       if S.Status<>0 then
  325. {$ENDIF}
  326.       begin
  327.         Close(f);
  328.         Exit;
  329.       end; { if }
  330.       Dec(l, x);
  331.     end; { while }
  332.     FreeMem(Buf, BufSize);
  333.   end; { if }
  334.   Close(f);
  335.   S.Seek(0);
  336. end; { LoadStream }
  337.  
  338. end.
  339.